perm filename SAMO2.F4[SAM,LCS] blob
sn#437762 filedate 1979-05-01 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C SAMO2 FOR INTERACTIVE USE.
C00004 ENDMK
Cā;
C SAMO2 FOR INTERACTIVE USE.
SUBROUTINE SAMO2(KKK,J1)
COMMON /CONV/A,INIOUT
DIMENSION L(30),KKK(1),KOUT(512)
DATA L/"1370600,"2060610,"100,"20140,"10430,
1 "401025000,"5400,"10000006400,"6200,"400007600,"1210027400,
1 "401035001,"15401,"10000006401,"6201,"400017601,"1210037401,
1 "401045002,"25402,"10000006402,"6202,"400027602,"1210047402,
1 "401055003,"35403,"10000006403,"6203,"400037603,"1210057403,
1 "430/
IF(J1.LT.0)GO TO 11
IF(INIOUT.EQ.0)GO TO 10
C NOW OPEN PROPER OUTPUT FILE
INIOUT=0
IDSK=0
CALL PUTEXT('TEST','SAM')
DO 1 K=1,30
1 KOUT(K)=L(K)
J1=J1+30
N=0
DO 2 K=31,J1
N=N+1
2 KOUT(K)=KKK(N)
IDSK=J1
99 IF(IDSK.LT.128)RETURN
CALL EXTOUT(KOUT,128)
DO 3 K=129,IDSK
3 KOUT(K-128)=KOUT(K)
IDSK=IDSK-128
IF(IDSK.GE.128)GO TO 99
RETURN
10 DO 4 K=1,J1
KOUT(IDSK)=KKK(K)
4 IDSK=IDSK+1
GO TO 99
11 DO 12 K=IDSK+1,128
12 KOUT(K)=0
CALL EXTOUT(KOUT,128)
CALL FINEXT
END